home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Janim / anim.f < prev    next >
Encoding:
FORTH Source  |  1992-01-28  |  6.5 KB  |  331 lines
  1. \ ANIM support for JForth, advance and display ANIMS
  2. \
  3. \ Utility for ANIM-5 support in JForth
  4. \ that adds to Phil Burk's IFF files
  5. \ in an integrated manner.
  6. \
  7. \ Author: Martin Kees  10/14/90
  8. \ Copyright: 1990 Martin Kees
  9. \ Freely distributable to the JForth Community
  10.  
  11. \ MOD: MCK 11/5/90  added ANIM.SAVE
  12. \ MOD: MCK 11/8/90  added ?closebox to ANIM.PLAY
  13. \ MOD: MCK 11/8/90  added file open check in ANIM.APPLYDISKDELTA
  14. \ MOD: MCK 11/10/90 used anim.display in anim.advance for hidden
  15. \                   transition support
  16. \ MOD: MCK 2/11/91  ANIM-ERROR support
  17. \ 00001 PLB 11/15/91 Removed calls to pic.?break
  18. \ 00002 PLB 11/15/91 New error handling scheme. Add ANIM.REWIND
  19. \ 00003 PLB 11/15/91 Add ANIM.VIEW, use ANIM.VIEW in ANIM.ADVANCE
  20. \ 00004 PLB 11/17/91 Add ANIM.GOTO.FRAME
  21. \ 00005 PLB 12/4/91 Made ANIM.ADVANCE not display. Added ANIM.DISPLAY.NEXT
  22. \           Removed references to ANIM-DISPLAYFLAG
  23. \ 00006 PLB 1/26/92 Changed ILBM.WRITE.BITMAP to ILBM.WRITE.BITMAP?
  24. \ 00007 PLB 1/28/92 Added ANIM.BLIT, fixed 0 ANIM.GOTO.FRAME,
  25. \           Changed ANIM.REWIND to use 0.
  26.  
  27. getmodule includes
  28. ANEW TASK-ANIM
  29.  
  30. : FREELIST? ( memptraddr -- , free a dynamic stack of allocated mem )
  31.     dup @
  32.     IF  dup @ dup freebyte 0
  33.         DO dup i + freevar
  34.             cell
  35.         +LOOP
  36.         drop
  37.         freevar
  38.     ELSE drop
  39.     THEN
  40. ;
  41.  
  42. variable DELTA-BUFF \ holds deltas for disk based anim, only ONE at a time
  43.  
  44. : ANIM.CHECK ( animation -- , abort if bad )
  45.     ..@ an_key
  46.     anim_valid_key -
  47.     abort" Invalid or Empty Animation"
  48. \    pic.?break \ 00001
  49. ;
  50.  
  51. : ANIM.DISPLAY ( anim -- )
  52.     s@ an_displaying pic.display
  53. ;
  54.  
  55. : ANIM.VIEW ( anim -- )
  56.     s@ an_displaying pic.view
  57. ;
  58.  
  59. : ANIM.BLIT ( xpos ypos anim -- , blit current pic ) \ 00007
  60.     s@ an_displaying pic.blit
  61. ;
  62.  
  63. : ANIM.FREE ( animation -- , free all parts of animation )
  64.     dup ..@ an_key
  65.     anim_valid_key =
  66.     IF  >r  ( save on RS )
  67.         r@ pic.free
  68.         r@ .. an_pic1 pic.free
  69.         r@ .. an_DELTAlist freelist?
  70.         r@ .. an_seeklist  freevar
  71.         r@ .. an_sizelist  freevar
  72.         r@ ..@ an_ytable   free.ytable
  73.         r@ .. an_$filename freevar
  74.         r> sizeof() animation erase
  75.     ELSE
  76.         drop
  77.     THEN
  78. ;
  79.  
  80. : ANIM.GET.DEPTH ( animation -- depth )
  81.     ..@ pic_bitmap ..@ bm_depth
  82. ;
  83.  
  84.  
  85. : ANIM.APPLYDELTA { anim | delta bmap  ytab --- }
  86.     anim ..@ an_ytable -> ytab
  87.     anim ..@ an_deltalist
  88.     anim ..@ an_atdelta cells + @ -> delta
  89.     anim ..@ an_hiding dup ..@ pic_bitmap -> bmap
  90. \
  91.     pic.get.depth 0
  92.     DO
  93.         delta i cells + @
  94.         ?dup
  95.         IF delta +
  96.             i bmap bmplane[] @ >rel
  97.             ytab
  98.             decode_vkplane
  99.         THEN
  100.     LOOP
  101.     anim ..@ an_atdelta 1+
  102.     dup anim ..@ an_cels = IF drop 1
  103.         THEN
  104.     anim ..! an_atdelta
  105. ;
  106.  
  107. : ANIM.APPLYDISKDELTA? { anim | bmap  ytab --- error? }
  108.     iff-fileid @
  109.     IF
  110. \ get seek position
  111.         anim ..@ an_seeklist
  112.         anim ..@ an_atdelta cells dup>r + @ iff.seek
  113. \
  114. \ read delta
  115.         delta-buff @
  116.         anim ..@ an_sizelist r> + @ iff.read? ?goto.error
  117. \
  118.         anim ..@ an_hiding dup ..@ pic_bitmap -> bmap
  119.         anim ..@ an_ytable -> ytab
  120.         pic.get.depth 0
  121.         DO
  122.             delta-buff @ i cells + @ ?dup
  123.             IF
  124.                 delta-buff @ +
  125.                 i bmap bmplane[] @ >rel
  126.                 ytab
  127.                 decode_vkplane
  128.             THEN
  129.         LOOP
  130.         anim ..@ an_atdelta 1+
  131.         dup anim ..@ an_cels =
  132.         IF drop 1
  133.         THEN
  134.         anim ..! an_atdelta
  135.     ELSE \ This is a programmer error so it is OK to abort!
  136.         ." ANIM.APPLYDISKDELTA? - Anim file not open! " abort
  137.     THEN
  138.     false
  139.     exit
  140. \
  141. ERROR:
  142.     true
  143. ;
  144.  
  145. : ANIM.DISK.OPEN? { animatn -- error? }
  146.     delta-buff freevar
  147.     animatn ..@ an_$filename $iff.open? 0= ?goto.error
  148. \ find size of largest cel
  149.     animatn ..@ an_sizelist 0
  150.     animatn ..@ an_cels 0
  151.     DO over i cells + @ max
  152.     LOOP
  153.     nip
  154. \
  155. \ allocate buffer for that
  156.     MEMF_PUBLIC swap allocblock delta-buff !
  157.     delta-buff @ 0=
  158.     IF ." Couldn't allocate delta buffer! " cr
  159.         iff.close
  160.         goto.error
  161.     THEN
  162.     false
  163.     exit
  164. \
  165. ERROR:
  166.     true
  167. ;
  168.  
  169. : ANIM.DISK.CLOSE ( --- )
  170.     iff.close
  171.     delta-buff freevar
  172. ;
  173.  
  174. : ANIM.ADVANCE? ( animation -- error? )
  175.     >r
  176.     r@ ..@ an_flags anim_diskmode and
  177.     IF    r@ anim.applydiskdelta?
  178.     ELSE  r@ anim.applydelta false \ no error
  179.     THEN
  180.     r@ ..@ an_hiding
  181.     r@ ..@ an_displaying
  182.     r@ ..! an_hiding
  183.     r@ ..! an_displaying
  184.     rdrop
  185. ;
  186.  
  187. : ANIM.ADVANCE ( animation -- )
  188.     anim.advance?
  189.     IF
  190.         ." ANIM.ADVANCE - couldn't!" cr abort
  191.     THEN
  192. ;
  193.  
  194. : ANIM.VIEW.NEXT? ( animation -- error? ) \ 00005
  195.     dup anim.advance? 0=
  196.     IF
  197.         anim.view FALSE
  198.     ELSE
  199.         drop TRUE
  200.     THEN
  201. ;
  202.  
  203. : ANIM.DISPLAY.NEXT? ( animation -- error? ) \ 00005
  204.     dup anim.advance? 0=
  205.     IF
  206.         anim.display FALSE
  207.     ELSE
  208.         drop TRUE
  209.     THEN
  210. ;
  211.  
  212. : ANIM.LAST.FRAME? ( animation --- flag )
  213.     dup ..@ an_cels 1-
  214.     swap ..@ an_atdelta
  215.     =
  216. ;
  217.  
  218. DEFER ANIM.DELAY
  219. ' Noop is anim.delay
  220.  
  221. : ANIM.PLAY { loopflag animatn --- }
  222.     animatn anim.check
  223.     animatn ..@ an_flags anim_diskmode and
  224.     IF animatn anim.disk.open? ?goto.error
  225.     THEN
  226. \
  227.     loopflag
  228.     IF \ loop continuously
  229.         BEGIN
  230.             animatn anim.view.next? \ 00005
  231.             anim.delay
  232.             ?terminal  OR
  233.             ?closebox OR
  234.         UNTIL
  235.     ELSE \ loop once
  236.         BEGIN
  237.             animatn anim.view.next? \ 00005
  238.             anim.delay
  239.             animatn anim.last.frame? OR
  240.             ?terminal OR
  241.             ?closebox OR
  242.         UNTIL
  243.     THEN
  244. \
  245.     animatn ..@ an_flags anim_diskmode and
  246.     IF anim.disk.close
  247.     THEN
  248. error:
  249. ;
  250.  
  251. : ANIM.STATS ( animation --- )
  252.     >r
  253.     r@ anim.check
  254.     cr
  255.     ." Size: " r@ pic.get.wh swap . ." X " . cr
  256.     ." Planes: " r@ anim.get.depth . cr
  257.     ." Cells: "  r@ ..@ an_cels 1- . cr
  258.     ." Mode: " r@ ..@ an_flags
  259.         anim_diskmode and
  260.         IF ." Disk Mode" cr
  261.         ELSE ." Memory Mode" cr
  262.         THEN
  263.     ." Current frame: " r@ ..@ an_atdelta . cr
  264.     rdrop
  265. ;
  266.  
  267.  
  268. : ILBM.WRITE.ILBM+CAMG+DPAN?  { bmap ctable ctable# camg dpancnk -- error? }
  269. \ This word is needed if writing a screen of data.
  270.     iff-fileid @ 0=
  271.     IF ." You must open an IFF file first using $IFF.OPEN?" cr
  272.         abort
  273.     THEN
  274.     'ilbm' iff.begin.form? ?goto.error  ( -- formpos )
  275. \
  276. \ Write CAMG value.
  277.     camg pad !
  278.     pad 4 'CAMG' iff.write.chunk? ?goto.error
  279. \
  280. \ Generate CMAP and write it.
  281.     ctable
  282.     IF  ctable pad ctable# ctable>cmap  ( use pad to pack cmap )
  283.         pad ctable# 3 * 'CMAP' iff.write.chunk? ?goto.error
  284.     THEN
  285. \
  286. \ Write DPAN chunk
  287.     dpancnk
  288.     IF  dpancnk 8 'DPAN' iff.write.chunk? ?goto.error
  289.     THEN
  290. \
  291. \ Write Bitmap
  292.     bmap ilbm.write.bitmap? ?goto.error \ 00006
  293. \
  294. \ Close out 'FORM'
  295.     ( -- formpos ) iff.end.form? ?goto.error
  296.     false
  297.     exit
  298. \
  299. ERROR:
  300.     true
  301. ;
  302.  
  303. : ANIM.GOTO.FRAME { frame# animatn -- , advance to that frame }
  304.     frame# animatn ..@ an_cels <
  305.     IF
  306. \ don't wait for zero because you'll never get there, 00007
  307.         frame# 0=
  308.         IF
  309.             animatn ..@ an_cels 1-  \ that's when cel0 reappears
  310.             -> frame#
  311.         THEN
  312.         BEGIN
  313.             animatn ..@ an_atdelta
  314.             frame# =
  315.         WHILE-NOT
  316.             animatn anim.advance? ?goto.error
  317.         REPEAT
  318.     ELSE
  319.         ." ANIM.GOTO.FRAME - frame# too large!" cr
  320.     THEN
  321.     exit
  322. error:
  323.     ." ANIM.GOTO.FRAME failed!" cr
  324. ;
  325.  
  326. : ANIM.REWIND ( animation -- , rewind to beginning )
  327.     0 swap anim.goto.frame \ 00007
  328. ;
  329.  
  330.  
  331.